
package Sgdb::Cntr::Etags ;

use Sgdb::Utils qw( :DEFAULT
                    bind_search_mechanism
                    bind_history_mechanism
                    localconfig
                    get_full_filename
                    ) ;

# pragmas for all
use warnings ;
use strict ;
use integer ;
use bytes ;

our @TAGS ;
init() ;

sub init {
    1;
}

sub new {

    my $self = shift or die "whoami" ;
    my $topf = shift or die "top frame needed" ;

    my $text = ( pref ('etags-lookup-show-scrollbars') ?
                 $topf -> Scrolled ( 'ROText', pref 'etags-lookup-text' ) :
                 $topf ->             ROText ( pref 'etags-lookup-text' ) ) ;

    balloonset $text =><<DoC ;
find predefined etags
DoC

    pref_tags $text, 'etags-lookup', qw/title lookup/;
    $text -> tagBind ( 'lookup', '<1>', [\&info_line, $text] ) ;
    $text -> tagBind ( 'lookup', '<Enter>', [$text, 'configure', -cursor, 'arrow'] ) ;
    $text -> tagBind ( 'lookup', '<Leave>', [$text, 'configure', -cursor, 'xterm'] ) ;

    { # menu
        my $m = $text -> menu() ;
        $m -> delete( 0 ) ;
        for my $i ( [ 'separator' ],
                    [ 'command',
                      -label => 'clear',
                      -command => [$text, 'delete', '1.0', 'end'],
                    ],
                    [ 'command',
                      -label => 'new TAGS ..',
                      -command => sub {
                          my $p = 'last-TAGS-filename' ;
                          my $f = find_file ( 0, 'Load Targets List', pref $p ) or return ;
                          @TAGS = () ;
                          load_etags( $text, $f ) ;
                      },
                    ],
                    [ 'separator' ],
                    [ 'command',
                      -label => 'close',
                      -command => [\&hook_run, 'close-current-data-pane'],
                    ],
                  ) { $m -> add ( @$i ) }
    }

    $text -> bind ("<Meta-Up>"   =>  sub {}) ;
    $text -> bind ("<Meta-Down>" =>  sub {}) ;

    my $lookup ;
    my $e = $topf -> Entry ( -textvariable => \$lookup,
                             pref 'etags-lookup-entry'
                             ) -> pack ( -side => 'top',
                                         -fill => 'x',
                                         -anchor => 'sw',
                                         ) ;

    balloonset $e => <<DoC ;
type in tag name or regexpr
then hit 'Retrun' to look it up
DoC

    my $hcb = bind_history_mechanism ( $e, \$lookup ) ;

    $e -> bind ("<Return>" => [\&etags_lookup,     $text, $hcb, \$lookup]) ;
    hook_add ( 'etags-lookup'    => [\&etags_lookup, $e, $text, $hcb ],
               'new-symbol-file' => sub { @TAGS = () } ,
               ) ;
 
    # algo: mmm..., too compicated

    bind_search_mechanism  $text, $e  ;

    pref_reconfigure ( 'etags-lookup-text' => $text ,
                       'etags-lookup-entry' => $e
                       ) ;

    $e -> focus () ;

    $text ;
}

sub load_etags {

    return 1 if @TAGS ;
    my $t = shift ;
    my $f = shift || get_full_filename( "TAGS" )
      or return telthemloud "can't find TAGS file" ;
    open F, $f
      or return telthemloud "can't open $f:$!" ;

    local $/ = "\f" ;
    @TAGS = <F> ;
    close F ;
    if ( istkwidget $t ) {
        $t -> delete ( '1.0' => 'end' ) ;
        $t -> insert ( 'end' , "\nload $f\n" ) ;
    }
    1 ;
}

sub etags_lookup {

    my ($e, $t, $hcb, $ref ) = @_ ;
    my $sym ;

    load_etags($t) or return ;

    if (ref $ref ) { $sym = $$ref ; $$ref = '' }
    else           { $sym =  $ref || '' }

    $sym =~ s/^\s+// ;
    $sym =~ s/\s+$// ;
    $sym or return   ;
    $hcb -> ( $sym ) ;

    busy ;
    my $re = qr/\b$sym\b/i ;

    $t -> markSet    ( 'can' => '1.0' ) ;
    $t -> markGravity( 'can', 'right' ) ;
    $t -> insert      ('can', "$sym:\n" => 'title' ) ;

    foreach my $ftag ( @TAGS ) {

        $ftag =~ $re or next ;  # the common case

        my ( $file, $size, $tags ) = $ftag =~ /^\n(.*?),(\d+)\n(.*)/s
          or return telthemloud "bad TAGS pattern: no filename" ;

#         ($size +1 == length $tags) # \f at the end of tags
#           or telme "bad length in TAGS" ;

        for ( split /^/, $tags ) {
            /$re/ or next ;
            my ($patt, $line) = /(.*)\177.*?(\d+),/ ;

            $t -> insert ('can' ,
                          "$file:"      => 'lookup',
                          $line || 0    => 'lookup',
                          '   '         => 'regtxt',
                          $patt || $_   => 'regtxt',
                          "\n"          => 'regtxt',
                         ) ;
        }
    }
    $t -> insert ('can' , "\n"          => 'regtxt' ) ;
    unbusy ;
}

sub info_line {
    busy ;
    my $t = shift ; 
    my $c = $t -> index ( 'current' ) ;
    my ($file, $line) = $t -> get ("$c linestart" => "$c lineend" ) =~ /^(.*?):(\d+)/ ;
    hook_run 'open-source-file', $file, $line if $line ;
    unbusy ;
}
